home *** CD-ROM | disk | FTP | other *** search
- #!/usr/bin/perl
-
- # deluser -- a utility to remove users from the system
- # delgroup -- a utilty to remove groups from the system
- my $version = "3.110ubuntu6";
-
- # Copyright (C) 2000 Roland Bauerschmidt <rb@debian.org>
- # Based on 'adduser' as pattern by
- # Guy Maor <maor@debian.org>
- # Ted Hajek <tedhajek@boombox.micro.umn.edu>
- # Ian A. Murdock <imurdock@gnu.ai.mit.edu>
-
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program; if not, write to the Free Software
- # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-
- ####################
- # See the usage subroutine for explanation about how the program can be called
- ####################
-
- use warnings;
- use strict;
- use Getopt::Long;
- use Debian::AdduserCommon;
-
- my $install_more_packages ;
-
- BEGIN {
- local $ENV{PERL_DL_NONLAZY}=1;
- eval 'use File::Find';
- if ($@) {
- $install_more_packages = 1;
- }
- #no warnings "File::Find";
- eval 'use File::Temp';
- if ($@) {
- $install_more_packages = 1;
- }
- }
-
-
- BEGIN {
- eval 'use Locale::gettext';
- if ($@) {
- *gettext = sub { shift };
- *textdomain = sub { "" };
- *LC_MESSAGES = sub { 5 };
- }
- eval {
- require POSIX;
- import POSIX qw(setlocale);
- };
- if ($@) {
- *setlocale = sub { return 1 };
- }
- }
-
- setlocale(LC_MESSAGES, "");
- textdomain("adduser");
-
- my $action = $0 =~ /delgroup$/ ? "delgroup" : "deluser";
- our $verbose = 1;
- my %pconfig = ();
- my %config = ();
- my $configfile;
- my @defaults;
- my $force;
-
-
- unless ( GetOptions ("quiet|q" => sub {$verbose = 0; },
- "debug" => sub {$verbose = 2; },
- "version|v" => sub { &version(); exit 0; },
- "help|h" => sub { &usage(); exit 0;},
- "group" => sub { $action = "delgroup";},
- "conf=s" => \$configfile,
- "system" => \$pconfig{"system"},
- "only-if-empty" => \$pconfig{"only_if_empty"},
- "remove-home" => \$pconfig{"remove_home"},
- "remove-all-files" => \$pconfig{"remove_all_files"},
- "backup" => \$pconfig{"backup"},
- "backup-to=s" => \$pconfig{"backup_to"},
- "force" => \$force
- ) ) {
- &usage;
- exit 1;
- }
-
- # everyone can issue "--help" and "--version", but only root can go on
- dief (gtx("Only root may remove a user or group from the system.\n")) if ($> != 0);
-
- if (!defined($configfile)) {
- @defaults = ("/etc/adduser.conf", "/etc/deluser.conf");
- } else {
- @defaults = ($configfile);
- }
-
- my @names = ();
- my ($user,$group);
-
- ######################
- # handling of @names #
- ######################
-
- while (defined(my $arg = shift(@ARGV))) {
- if (defined($names[0]) && $arg =~ /^--/) {
- dief (gtx("No options allowed after names.\n"));
- } else { # it's a username
- push (@names, $arg);
- }
- }
-
- if(@names == 0) {
- if($action eq "delgroup") {
- print (gtx("Enter a group name to remove: "));
- } else {
- print (gtx("Enter a user name to remove: "));
- }
- chomp(my $answer=<STDIN>);
- push(@names, $answer);
- }
-
- if (length($names[0]) == 0 || @names > 2) {
- dief (gtx("Only one or two names allowed.\n"));
- }
-
- if(@names == 2) { # must be deluserfromgroup
- $action = "deluserfromgroup";
- $user = shift(@names);
- $group = shift(@names);
- } else {
- if($action eq "delgroup") {
- $group = shift(@names);
- } else {
- $user = shift(@names);
- }
- }
-
- undef(@names);
-
-
- ##########################################################
- # (1) preseed the config
- # (2) read the default /etc/adduser.conf configuration.
- # (3) read the default /etc/deluser.conf configuration.
- # (4) process commmand line settings
- # last match wins
- ##########################################################
-
- preseed_config (\@defaults,\%config);
-
- foreach(keys(%pconfig)) {
- $config{$_} = $pconfig{$_} if ($pconfig{$_});
- }
- undef (%pconfig);
-
- if (($config{remove_home} || $config{remove_all_files} || $config{backup}) && ($install_more_packages)) {
- fail (8, gtx("In order to use the --remove-home, --remove-all-files, and --backup features,
- you need to install the `perl-modules' package. To accomplish that, run
- apt-get install perl-modules.\n"));
- }
-
-
- my ($pw_uid, $pw_gid, $pw_homedir, $gr_gid, $maingroup);
-
- if($user) {
- my @passwd = getpwnam($user);
- $pw_uid = $passwd[2];
- $pw_gid = $passwd[3];
- $pw_homedir = $passwd[7];
-
- $maingroup = $pw_gid ? getgrgid($pw_gid) : "";
- }
- if($group) {
- #($gr_name,$gr_passwd,$gr_gid,$gr_members) = getgrnam($group);
- my @group = getgrnam($group);
- $gr_gid = $group[2];
- }
-
- # arguments are processed:
- #
- # $action = "deluser"
- # $user name of the user to remove
- #
- # $action = "delgroup"
- # $group name of the group to remove
- #
- # $action = "deluserfromgroup"
- # $user the user to be remove
- # $group the group to remove him/her from
-
-
- if($action eq "deluser") {
- &invalidate_nscd();
-
- my($dummy1,$dummy2,$uid);
-
-
-
-
-
- # Don't allow a non-system user to be deleted when --system is given
- # Also, "user does not exist" is only a warning with --system, but an
- # error without --system.
- if( $config{"system"} ) {
- if( ($dummy1,$dummy2,$uid) = getpwnam($user) ) {
- if ( ($uid < $config{"first_system_uid"} ||
- $uid > $config{"last_system_uid" } ) ) {
- printf (gtx("The user `%s' is not a system user. Exiting.\n"), $user) if $verbose;
- exit 1;
- }
- } else {
- printf (gtx("The user `%s' does not exist, but --system was given. Exiting.\n"), $user) if $verbose;
- exit 0;
- }
- }
-
- unless(exist_user($user)) {
- fail (2,gtx("The user `%s' does not exist.\n"),$user);
- }
-
- # Warn in any case if you want to remove the root account
- if ((defined($pw_uid)) && ($pw_uid == 0) && (!defined($force))) {
- printf (gtx("WARNING: You are just about to delete the root account (uid 0)\n"));
- printf (gtx("Usually this is never required as it may render the whole system unusable\n"));
- printf (gtx("If you really want this, call deluser with parameter --force\n"));
- printf (gtx("Stopping now without having performed any action\n"));
- exit 9;
- }
-
-
- if($config{"remove_home"} || $config{"remove_all_files"}) {
- s_print (gtx("Looking for files to backup/remove ...\n"));
- my @mountpoints;
- open(MOUNT, "mount |")
- || fail (4 ,gtx("fork for `mount' to parse mount points failed: %s\n", $!));
- while (<MOUNT>) {
- my @temparray = split;
- my $fstype = $temparray[4];
- my $exclude_fstypes = $config{"exclude_fstypes"};
- if (defined($exclude_fstypes)) {
- next if ($fstype =~ /$exclude_fstypes/);
- }
- push @mountpoints,$temparray[2];
- }
- close(MOUNT) or dief (gtx("pipe of command `mount' could not be closed: %s\n",$!));
- my(@files,@dirs);
- if($config{"remove_home"} && ! $config{"remove_all_files"}) {
-
- # collect all files in user home
- sub home_match {
- # according to the manpage
- foreach my $mount (@mountpoints) {
- if( $File::Find::name eq $mount ) {
- s_printf (gtx("Not backing up/removing `%s', it is a mount point.\n"),$File::Find::name);
- $File::Find::prune=1;
- return;
- }
- }
- foreach my $re ( split ' ', $config{"no_del_paths"} ) {
- if( $File::Find::name =~ qr/$re/ ) {
- s_printf (gtx("Not backing up/removing `%s', it matches %s.\n"),$File::Find::name,$re);
- $File::Find::prune=1;
- return;
- }
- }
-
- push(@files, $File::Find::name)
- if(-f $File::Find::name || -l $File::Find::name);
- push(@dirs, $File::Find::name)
- if(-d $File::Find::name);
- } # sub home_match
-
- # collect ecryptfs config files not stored in $HOME
- sub ecryptfs_match {
- if ( $File::Find::name !~ m[^/var/lib/ecryptfs/\Q$user] && $File::Find::name !~ m[^/home/\.ecryptfs/\Q$user]) {
- $File::Find::prune=1;
- return;
- }
- push(@files, $File::Find::name)
- if(-f $File::Find::name || -l $File::Find::name);
- push(@dirs, $File::Find::name)
- if(-d $File::Find::name);
- } # sub ecryptfs_match
-
- File::Find::find({wanted => \&home_match, untaint => 1, no_chdir => 1}, $pw_homedir)
- if(-d "$pw_homedir");
- if(-d "/var/lib/ecryptfs/$user") {
- File::Find::find({wanted => \&ecryptfs_match, untaint => 1, no_chdir => 1}, "/var/lib/ecryptfs/$user");
- } elsif (-d "/home/.ecryptfs/$user") {
- File::Find::find({wanted => \&ecryptfs_match, untaint => 1, no_chdir => 1}, "/home/.ecryptfs/$user");
- }
- push(@files, "/var/mail/$user")
- if(-e "/var/mail/$user");
- } else {
-
- # collect all files on system belonging to that user
- sub find_match {
- my ($dev,$ino,$mode,$nlink,$uid,$gid);
- (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) &&
- ($uid == $pw_uid) &&
- (
- ($File::Find::name =~ /^\/proc\// && ($File::Find::prune = 1)) ||
- (-f $File::Find::name && push(@files, $File::Find::name)) ||
- (-d $File::Find::name && push(@dirs, $File::Find::name)) ||
- (-l $File::Find::name && push(@dirs, $File::Find::name)) ||
- (-s $File::Find::name && push(@dirs, $File::Find::name)) ||
- (-p $File::Find::name && push(@dirs, $File::Find::name))
- );
- } # sub find_match
-
- File::Find::find({wanted => \&find_match, untaint => 1, no_chdir => 1}, '/');
- }
-
- if($config{"backup"}) {
- s_printf (gtx("Backing up files to be removed to %s ...\n"),$config{"backup_to"});
- my $filesfile = new File::Temp(TEMPLATE=>"deluser.XXXXX", DIR=>"/tmp");
- my $filesfilename = $filesfile->filename;
- my $backup_name = $config{"backup_to"} . "/$user.tar";
- print "backup_name = $backup_name";
- print $filesfile join("\n",@files);
- $filesfile->close();
- my $tar = &which('tar');
- my $bzip2 = &which('bzip2', 1);
- my $gzip = &which('gzip', 1);
- my $options = '';
- if($bzip2) {
- $backup_name = "$backup_name.bz2";
- $options = "--bzip2";
- } elsif($gzip) {
- $backup_name = "$backup_name.gz";
- $options = "--gzip";
- }
- &systemcall($tar, $options, "-cf", $backup_name, "--files-from", $filesfilename);
- chmod 0600, $backup_name;
- my $rootid = 0;
- chown $rootid, $rootid, $backup_name;
- unlink($filesfilename);
- }
-
- if(@files || @dirs) {
- s_print (gtx("Removing files ...\n"));
- unlink(@files) if(@files);
- foreach(reverse(sort(@dirs))) {
- rmdir($_);
- }
- }
- }
-
- if (system("crontab -l $user >/dev/null 2>&1") == 0) {
- # crontab -l returns 1 if there is no crontab
- my $crontab = &which('crontab');
- &systemcall($crontab, "-r", $user);
- s_print (gtx("Removing crontab ...\n"));
- }
-
- s_printf (gtx("Removing user `%s' ...\n"),$user);
- my @members = get_group_members($maingroup);
- if (@members == 0) {
- s_printf (gtx("Warning: group `%s' has no more members.\n"), $maingroup);
- }
- my $userdel = &which('userdel');
- &systemcall($userdel, $user);
- &invalidate_nscd();
-
- systemcall('/usr/local/sbin/deluser.local', $user, $pw_uid,
- $pw_gid, $pw_homedir) if (-x "/usr/local/sbin/deluser.local");
-
- s_print (gtx("Done.\n"));
- exit 0;
- }
-
-
- if($action eq "delgroup") {
- &invalidate_nscd();
- unless(exist_group($group)) {
- printf( gtx("The group `%s' does not exist.\n"),$group) if $verbose;
- exit 3;
- }
- my($dummy,$gid,$members);
- if( !(($dummy, $dummy, $gid, $members ) = getgrnam($group)) ) {
- fail (4 ,gtx("getgrnam `%s' failed. This shouldn't happen.\n"), $group);
- }
- if( $config{"system"} &&
- ($gid < $config{"first_system_gid"} ||
- $gid > $config{"last_system_gid" } )) {
- printf (gtx("The group `%s' is not a system group. Exiting.\n"), $group) if $verbose;
- exit 3;
- }
- if( $config{"only_if_empty"} && $members ne "") {
- fail (5, gtx("The group `%s' is not empty!\n"),$group);
- }
-
- setpwent;
- while ((my $acctname,my $primgrp) = (getpwent)[0,3]) {
- if( $primgrp eq $gr_gid ) {
- fail (7, gtx("`%s' still has `%s' as their primary group!\n"),$acctname,$group);
- }
- }
- endpwent;
-
- s_printf (gtx("Removing group `%s' ...\n"),$group);
- my $groupdel = &which('groupdel');
- &systemcall($groupdel,$group);
- &invalidate_nscd();
- s_print (gtx("Done.\n"));
- exit 0;
- }
-
-
- if($action eq "deluserfromgroup")
- {
- &invalidate_nscd();
- unless(exist_user($user)) {
- fail (2, gtx("The user `%s' does not exist.\n"),$user);
- }
- unless(exist_group($group)) {
- fail (3, gtx("The group `%s' does not exist.\n"),$group);
- }
- if($maingroup eq $group) {
- fail (7, gtx("You may not remove the user from their primary group.\n"));
- }
-
- my @members = get_group_members($group);
- my $ismember = 0;
-
- for(my $i = 0; $i <= $#members; $i++) {
- if($members[$i] eq $user) {
- $ismember = 1;
- splice(@members,$i,1);
- }
- }
-
- unless($ismember) {
- fail (6, gtx("The user `%s' is not a member of group `%s'.\n"),$user,$group);
- }
-
- s_printf (gtx("Removing user `%s' from group `%s' ...\n"),$user,$group);
- #systemcall("usermod","-G", join(",",@groups), $user );
- my $gpasswd = &which('gpasswd');
- &systemcall($gpasswd,'-M', join(',',@members), $group);
- &invalidate_nscd();
- s_print (gtx("Done.\n"));
- }
-
-
- ######
-
- sub fail {
- my ($errorcode, $format, @args) = @_;
- printf STDERR "$0: $format",@args;
- exit $errorcode;
-
- }
-
- sub version {
- printf (gtx("deluser version %s\n\n"), $version);
- printf (gtx("Removes users and groups from the system.\n"));
-
- printf gtx("Copyright (C) 2000 Roland Bauerschmidt <roland\@copyleft.de>\n\n");
-
- printf gtx("deluser is based on adduser by Guy Maor <maor\@debian.org>, Ian Murdock\n".
- "<imurdock\@gnu.ai.mit.edu> and Ted Hajek <tedhajek\@boombox.micro.umn.edu>\n\n");
-
- printf gtx("This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or (at
- your option) any later version.
-
- This program is distributed in the hope that it will be useful, but
- WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- General Public License, /usr/share/common-licenses/GPL, for more details.\n");
- }
-
- sub usage {
- printf gtx(
- "deluser USER
- remove a normal user from the system
- example: deluser mike
-
- --remove-home remove the users home directory and mail spool
- --remove-all-files remove all files owned by user
- --backup backup files before removing.
- --backup-to <DIR> target directory for the backups.
- Default is the current directory.
- --system only remove if system user
-
- delgroup GROUP
- deluser --group GROUP
- remove a group from the system
- example: deluser --group students
-
- --system only remove if system group
- --only-if-empty only remove if no members left
-
- deluser USER GROUP
- remove the user from a group
- example: deluser mike students
-
- general options:
- --quiet | -q don't give process information to stdout
- --help | -h usage message
- --version | -v version number and copyright
- --conf | -c FILE use FILE as configuration file\n\n");
- }
-
- sub exist_user {
- my $exist_user = shift;
- return(defined getpwnam($exist_user));
- }
-
- sub exist_group {
- my $exist_group = shift;
- return(defined getgrnam($exist_group));
- }
-
- # vim:set ai et sts=4 sw=4 tw=0:
-